home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 44 / Amiga Format CD44 (1999-08-26)(Future Publishing)(GB)(Track 1 of 3)[!][issue 1999-10].iso / -in_the_mag- / basics / amos / moreuselssprgs.lha / JokeBox.AMOS / JokeBox.amosSourceCode < prev    next >
AMOS Source Code  |  1997-04-18  |  6KB  |  253 lines
  1. ' *************************************
  2. ' *                                   *
  3. ' *           Jokebox V1.0            *
  4. ' *      Written by Chris Hodges      *
  5. ' *                                   *
  6. ' *************************************
  7. '                          
  8. Hide 
  9. Reserve As Chip Work 99,(320/8)*256
  10. Set Tempras 99,Length(99)
  11.  Extension_8_10F2 125 : Extension_8_108E 3 : Extension_8_10C6 64
  12. Screen Open 1,320,256,2,0
  13. Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  14. Screen Open 0,320,256,8,0
  15. Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  16. Screen Display 0,128,40,320,255
  17. Screen Offset 0,1,0
  18. Double Buffer 
  19. 'Screen To Front 1 
  20. Dim CV(2)
  21. CV(0)=$88F : CV(1)=$448 : CV(2)=$224
  22. For A=0 To 2
  23.   For C=0 To 7
  24.     AA=A : CO=0
  25.     For AAA=0 To 2
  26.       Add AA,1,0 To 2
  27.       If( Extension_8_04F8(AA) and C)>0 Then CO=CV(2-AAA)
  28.     Next 
  29.      Extension_8_14C6 A,C,CO
  30.   Next 
  31. Next 
  32. Screen 1 : BP=0 : W=0 : ANG=512 : ZF=3072
  33. MX1=0 : MY1=0 : MX2=320 : MY2=256
  34.  Extension_8_128A 0
  35. Repeat 
  36.   Timer=0
  37.    Extension_8_121C 1,0
  38.   VECROTTEXT[160,80,Min(ANG,10240+512),ZF,1,"STRATO"]
  39.   VECROTTEXT[160,160,-Min(ANG-256,10240+512),ZF,1,"IMPACT"]
  40.    Extension_8_1058 1,0 To 0,BP
  41.    Extension_8_149E BP,0 : View 
  42.   W=1-W : If W Then Add BP,1,0 To 2
  43.   Screen Swap : Wait Vbl 
  44.   For A=1 To Timer
  45.     If ZF>256 Then Add ZF,-4
  46.     Add ANG,12
  47.     If ANG>10240+512 Then Inc TIMOUT
  48.   Next 
  49. Until TIMOUT>50
  50. Screen 0
  51. For A=1 To 7 : Colour A,CV(0) : Next 
  52. BLAB:
  53. Unpack 8 To 1 : Screen Hide 
  54. Screen Offset 1,1,0
  55. Screen Display 1,128,40,320,255
  56. Screen 0
  57. Screen Copy 1 To 0 : Screen Swap 
  58. Screen Copy 1 To 0 : Screen Swap 
  59. Fade 1 To 1
  60. Wait 16
  61. Screen Show 1 : Wait Vbl 
  62. Unpack 7 To 0 : Screen Hide 
  63. Screen Display 0,128,40,320,256
  64. Screen Offset 0,321,0
  65. For A=0 To 7 : Screen 1 : C=Colour(A) : Screen 0 : Colour A+8,C : Next 
  66. Screen To Front 1 : Wait Vbl 
  67. Screen Show 0
  68. Wait Vbl 
  69. Dual Playfield 0,1
  70. Wait Vbl : AD=Cop Logic : View 
  71. YY=$68
  72. Do 
  73.   Exit If(Deek(AD) and 1) and Peek(AD)>$38
  74.   Add AD,4
  75. Loop 
  76. LAD=AD : P=-31 : PS=101
  77. LL=Leek(AD)
  78. Screen 0
  79. Repeat 
  80.   Wait Vbl 
  81.   Add P,PS
  82.   Dec PS
  83.   ILEAVECOP[Logbase(0)-2,Logbase(1)-2,Logbase(2)-2,AD,Max(P/16,0),LL]
  84. Until P=320*16
  85. Screen Offset 0,1,0 : View 
  86. Screen 1 : Get Palette 0 : Screen 0
  87. For A=1 To 7 : Colour A,$FFF : Next 
  88. Fade 3 To 1
  89. PDB= Extension_8_1386 
  90. PP=PDB-(18+4*31+4*11*4-2)
  91. Do 
  92.   Wait Vbl 
  93.   For V=0 To 3
  94.     IN=Peek(PP+V*44)/16
  95.     If IN=1 or Extension_8_10B6 =1 Then Colour 0,$FFF : Fade 1 To 1
  96.   Next 
  97.   Exit If Mouse Key or Inkey$<>""
  98. Loop 
  99. NEX:
  100. Screen Open 0,320,256,8,0
  101. Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  102. Palette 0,$AAA,$777,$555
  103. Double Buffer 
  104. Autoback 0
  105. Restore COORDS
  106. Read NUMCO
  107. Dim CO(NUMCO,2),RC(NUMCO,2)
  108. For A=1 To NUMCO
  109.   Read CO(A,0),CO(A,1),CO(A,2)
  110. Next 
  111. Restore SHAPES
  112. Read NUMLI
  113. Dim LI(NUMLI,4)
  114. For A=1 To NUMLI
  115.   Read LI(A,0),LI(A,1),LI(A,2),LI(A,3)
  116.   Read LI(A,4)
  117. Next 
  118. Dim SOAR$(NUMLI-1)
  119. AX=256 : AY=0 : AZ=0
  120. Repeat 
  121.    Extension_8_1234 0,0,96,80 To 224,176
  122.   Add AX,5
  123.   Add AY,8
  124.   Add AZ,11
  125.    Extension_8_1138 AX,AY,AZ
  126.    Extension_8_1122 0,0,3000
  127.    Extension_8_1152 
  128.    Extension_8_1234 0,1,96,80 To 224,176
  129.   For A=1 To NUMCO
  130.     RC(A,0)= Extension_8_1178(CO(A,0),CO(A,1),CO(A,2))+160
  131.     RC(A,1)= Extension_8_1184 +128
  132.     RC(A,2)= Extension_8_11C4 
  133.   Next 
  134.   For A=1 To NUMLI
  135.     C1=LI(A,0) : C2=LI(A,1) : C3=LI(A,2) : C4=LI(A,3)
  136.     CO=LI(A,4)
  137.     Z=(RC(C1,2)+RC(C2,2)+RC(C3,2)+RC(C4,2))/4
  138.     SOAR$(A-1)= Extension_8_08D2(-Z)+ Extension_8_08D2(RC(C1,0))+ Extension_8_08D2(RC(C1,1))+ Extension_8_08D2(RC(C2,0))+ Extension_8_08D2(RC(C2,1))
  139.     SOAR$(A-1)=SOAR$(A-1)+ Extension_8_08D2(RC(C3,0))+ Extension_8_08D2(RC(C3,1))+ Extension_8_08D2(RC(C4,0))+ Extension_8_08D2(RC(C4,1))+ Extension_8_08C4(CO)
  140.   Next 
  141.   Sort SOAR$(0)
  142.   For A=1 To NUMLI
  143.     AD=Varptr(SOAR$(A-1))
  144.     CO=Deek(AD+36)
  145.     X1=Leek(AD+4) : Y1=Leek(AD+8)
  146.     X2=Leek(AD+12) : Y2=Leek(AD+16)
  147.     X3=Leek(AD+20) : Y3=Leek(AD+24)
  148.     X4=Leek(AD+28) : Y4=Leek(AD+32)
  149.     DI=(X3-X1)*(Y2-Y1)-(X2-X1)*(Y3-Y1)
  150.     If DI<0
  151.       Ink CO : Polygon X1,Y1 To X2,Y2 To X3,Y3 To X4,Y4
  152.     Else 
  153.       If CO=2
  154.         Ink 0
  155.       Else 
  156.         Ink CO
  157.         Polygon X1,Y1 To X2,Y2 To X3,Y3 To X4,Y4
  158.       End If 
  159.     End If 
  160.   Next 
  161.   Plot RC(9,0),RC(9,1),1
  162.   Screen Swap 
  163.   Wait Vbl 
  164. Until Inkey$=Chr$(27) or Mouse Key<>0
  165. Screen Close 0
  166. End 
  167. '  1_____2   
  168. ' 5/____/| 
  169. ' | |  |6| 
  170. ' |4|__|_|3  
  171. ' |/___|/
  172. ' 8    7 
  173. COORDS:
  174.   Data 9
  175. ' CUBE 
  176.   Data -100,-100,-100
  177.   Data 100,-100,-100
  178.   Data 100,-100,100
  179.   Data -100,-100,100
  180.   Data -100,100,-100
  181.   Data 100,100,-100
  182.   Data 100,100,100
  183.   Data -100,100,100
  184.   Data 0,100,0
  185.  
  186. SHAPES:
  187.   Data 5
  188. ' All lines are drawn in anticlockwise.
  189.   Data 1,2,6,5,3
  190.   Data 4,3,2,1,2
  191.   Data 2,3,7,6,1
  192.   Data 3,4,8,7,3
  193.   Data 4,1,5,8,1
  194.  
  195. Procedure VECTEXT[X,Y,SX,SY,C,T$]
  196.   Shared MX1,MY1,MX2,MY2
  197.   ST=Start(16)
  198.   TX=X-(Len(T$)*24*SX)/256
  199.   MX1=Max(TX,0) : MY1=Max(Y-(SY*32)/256,0)
  200.   For A=1 To Len(T$)
  201.     X=TX+((A*48-24)*SX)/256
  202.     P=Asc(Mid$(T$,A,1))-32
  203.     AD=ST+Deek(ST+P*2)
  204.     Do 
  205.       X1= Extension_8_0BE4(AD) : Y1= Extension_8_0BE4(AD+2) : Add AD,4
  206.       Exit If Deek(AD-4)=$8000
  207.       X1=(X1*SX)/256+X : Y1=(Y1*SY)/256+Y
  208.       OX=X1 : OY=Y1
  209.       Do 
  210.         X2= Extension_8_0BE4(AD) : Y2= Extension_8_0BE4(AD+2) : Add AD,4
  211.         Exit If Deek(AD-4)=$8000
  212.         X2=(X2*SX)/256+X : Y2=(Y2*SY)/256+Y
  213.          Extension_8_1030 X1,Y1 To X2,Y2,C,-C
  214.         X1=X2 : Y1=Y2
  215.       Loop 
  216.        Extension_8_1030 X1,Y1 To OX,OY,C,-C
  217.     Loop 
  218.   Next 
  219.   MX2=Min(X+15,320) : MY2=Min(Y+(SY*32)/256,256)
  220. End Proc
  221. Procedure VECROTTEXT[X,Y,W,Z,C,T$]
  222.   ST=Start(16)
  223.    Extension_8_1138 W,256,0
  224.    Extension_8_1122 0,0,Z
  225.    Extension_8_1152 
  226.   For A=1 To Len(T$)
  227.     TX=(A*48-24)-Len(T$)*24
  228.     P=Asc(Mid$(T$,A,1))-32
  229.     AD=ST+Deek(ST+P*2)
  230.     Do 
  231.       X1= Extension_8_0BE4(AD) : Y1= Extension_8_0BE4(AD+2) : Add AD,4
  232.       Exit If Deek(AD-4)=$8000
  233.       X1= Extension_8_1178(X1+TX,Y1,0)+X
  234.       Y1= Extension_8_1184 +Y
  235.       OX=X1 : OY=Y1
  236.       Do 
  237.         X2= Extension_8_0BE4(AD) : Y2= Extension_8_0BE4(AD+2) : Add AD,4
  238.         Exit If Deek(AD-4)=$8000
  239.         X2= Extension_8_1178(X2+TX,Y2,0)+X
  240.         Y2= Extension_8_1184 +Y
  241.          Extension_8_1030 X1,Y1 To X2,Y2,C,-C
  242.         X1=X2 : Y1=Y2
  243.       Loop 
  244.        Extension_8_1030 X1,Y1 To OX,OY,C,-C
  245.     Loop 
  246.   Next 
  247. End Proc
  248. Procedure ILEAVECOP[LG0,LG1,LG2,CP,POS,LASTLONG]
  249.    ' COMPILED PROCEDURE -- can't convert this to AMOS code
  250. End Proc
  251. 'Procedure ILEAVECOP[LG0,LG1,LG2,CP,POS,LASTLONG]
  252. '
  253. 'End Proc